home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / cmln0586.arc / FILLING4.LTG < prev    next >
Text File  |  1986-04-06  |  3KB  |  70 lines
  1.  
  2.                             Listing 4
  3.          An extremely efficient seed filling algorithm.
  4.  
  5. procedure Fill(x,y,NewColor: Integer);
  6.  
  7. var
  8.   EraseColor,StartLeftx,StartRightx,i: Integer;
  9.  
  10.   procedure RecursiveFill(Leftx,Rightx,y,ParentLeftx,ParentRightx,
  11.                           Direction: Integer);
  12.   var
  13.     NextLeftx, NextRightx: Integer;
  14.   begin {of procedure RecursiveFill}
  15.   NextLeftx := Leftx;                  {start at leftmost point in shadow}
  16.   Repeat                               {search for run in current shadow}
  17.     if PD(NextLeftx,y)=EraseColor      {find next leftmost x}
  18.     then
  19.       begin
  20.       NextRightx := NextLeftx;
  21.       while PD(NextLeftx-1,y)=EraseColor do
  22.         NextLeftx := NextLeftx-1;
  23.       end
  24.     else
  25.       begin
  26.       NextLeftx := NextLeftx + 1;
  27.       while (PD(NextLeftx,y)<>EraseColor) and (NextLeftx <= Rightx) do
  28.         NextLeftx := NextLeftx+1;
  29.       NextRightx := NextLeftx;
  30.       end;
  31.     if NextLeftx <= Rightx             {find next rightmost x}
  32.     then
  33.       begin
  34.       while PD(NextRightx+1,y)=EraseColor do
  35.         NextRightx := NextRightx + 1;
  36.       for i := NextLeftx to NextRightx do   {fill current run}
  37.         DP(i,y,NewColor);
  38.       RecursiveFill(NextLeftx,NextRightx,y-Direction,NextLeftx,
  39.                     NextRightx,Direction);   {call fill algorithm}
  40.       if NextLeftx <= ParentLeftx - 2        {with valid shadows}
  41.       then RecursiveFill(NextLeftx,ParentLeftx-2,y+Direction,NextLeftx,
  42.                          NextRightx,-Direction);
  43.       if ParentRightx + 2 <= NextRightx
  44.       then RecursiveFill(ParentRightx+2,NextRightx,y+Direction,NextLeftx,
  45.                          NextRightx,-Direction);
  46.       NextLeftx := NextRightx + 2;     {skip to next possible leftmost x}
  47.       end;
  48.   Until NextLeftx > Rightx;            {repeat until entire shadow examined}
  49.   end; {of procedure RecursiveFill}
  50.  
  51. begin {of procedure Fill}
  52. EraseColor := PD(x,y);                 {record color of seed point}
  53. if EraseColor = NewColor then exit;    {already done}
  54. if EraseColor = -1 then exit;          {seed point is off screen}
  55. StartLeftx := x;                       {find leftmost x in starting run}èwhile PD(StartLeftx-1,y)=EraseColor do
  56.   StartLeftx := StartLeftx - 1;
  57. StartRightx := x;                      {find rightmost x in starting run}
  58. while PD(StartRightx+1,y)=EraseColor do
  59.   StartRightx := StartRightx + 1;
  60. for i := StartLeftx to StartRightx do  {fill starting span}
  61.   DP(i,y,NewColor);
  62. RecursiveFill(StartLeftx,StartRightx,y-1,StartLeftx,
  63.               StartRightx,+1);         {examine shadows of run}
  64. RecursiveFill(StartLeftx,StartRightx,y+1,StartLeftx,
  65.               StartRightx,-1);
  66. end; {of procedure Fill}
  67.  
  68.  
  69.  
  70.